home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
SAT 2.3.8
/
Libraries & Documentation
/
Add-ons
/
Graphic effects
/
GammaFade.p
< prev
next >
Wrap
Text File
|
1995-11-10
|
13KB
|
428 lines
unit GammaFade;
{--------------------------------------------------------------------------------------------------------------- }
{ File "gamma.p" - Source for Altering the Gamma Tables of GDevices from Gamma.c }
{ Last updated 6/29/95, MJS }
{--------------------------------------------------------------------------------------------------------------- }
{ 7-13-95 ported to pascal by Matthew Xavier Mora mxmora@mxmdesigns.com }
{ 7-18-95 fixed all the porting bugs and got it to work in think pascal }
{----------------------------------------------------------------------------------------------------------------}
{ 7-18-95 ported to CW (68k and PPC) by Bill Catambay (pretty easy), cleaned the code a bit (no more labels), }
{ brought back Matthew's delay fade routines (in main program). }
{----------------------------------------------------------------------------------------------------------------}
{ august -95: Change by Ingemar R: Moved the FadeToBlack and FadeFromBlack calls to}
{ this unit and modified them to be timed by TickCount and aborted by mouse clicks.}
{ DoGammaFade now auto-initializes - no call to SetupGammaTools is needed.}
{ You can use FadeToBlack and FadeFromBlack only. They both check for gamma tables}
{ to be available, so you don't have to call IsGammaAvailable yourself.}
{ These changes were made when making a SAT add-on unit of it.}
{---------------------------------------------------------------------------------------------------------------}
{ This is the Source Code for the Gamma Utils Library file. Use this to build }
{ new functionality into the library or make an A4-based library. }
{ See the header file "gamma.h" for much more information. -- MJS }
{---------------------------------------------------------------------------------------------------------------}
interface
uses
{$IFC UNDEFINED THINK_PASCAL}
ToolUtils, Devices,
{$ENDC}
Traps, Video;
{ Function Prototypes}
function IsGammaAvailable: Boolean;
function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
{ These routines help you determine whether you can use the Gamma Table Utils}
{ on the current machine. The first checks all attached monitors, and the }
{ second just checks the indicated monitor. Each returns TRUE if you can }
{ use the functions, or FALSE if you can't. • Note: Before calling any other}
{ Gamma Table function below, use this function to see if you are allowed.}
{ * ****************************************************************************** *}
function SetupGammaTools: OSErr;
function DisposeGammaTools: OSErr;
{ These routines must bracket any calls to the Gamma Table functions, perhaps}
{ at the head and tail of your main(). The first sets up the data structures}
{ necessary to save and restore the state of your monitors. The second}
{ disposes of all the internal data structures, but does not reset the}
{ monitors to their original states. Both return the error code if some}
{ part failed. }
{ * ****************************************************************************** *}
function DoGammaFade (percent: Integer): OSErr;
function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
{ Use the first function to Fade each of your monitors to some percentage of their}
{ initial brightness (100 = bright, 0 = dim). Repeatedly call this to ramp your}
{ monitors up or down. The second function performs the same function, but only}
{ for the specified monitor. Both return any applicable error codes.}
{ Be sure to set up the necessary save-state data structures before you start by}
{ calling the compatibility and initialization functions. }
{ * ****************************************************************************** *}
{function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;}
{function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;}
{ These routines are low-level interfaces to the device drivers for the monitors.}
{ Use them at your own risk.}
{NO LONGER EXPORTED! /Ingemar}
{Quick fixed-time calls:}
procedure FadeToBlack (ticks: Longint);
procedure FadeFromBlack (ticks: Longint);
implementation
const
kGammaUtilsSig = 'GAMA';
kGetDeviceListTrapNum = $AA29;
type
GlobalGammasPtr = ^GlobalGammas;
GlobalGammasHdl = ^GlobalGammasPtr;
GlobalGammas = record
size, dataOffset: Integer;
saved, hacked: GammaTblHandle;
theGDevice: GDHandle;
next: GlobalGammasHdl;
end;
GammaData = packed array[0..100000] of Byte; {used to set the gamma}
GammaDataPtr = ^GammaData;
var
gammaUtilsInstalled: OSType;
gammaTables: GlobalGammasHdl;
function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
forward;
function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
forward;
{Fixed-time fading routines that can be aborted with a mouse click.}
procedure FadeToBlack (ticks: Longint);
var
i: integer;
oe: OSErr;
startTicks: Longint;
begin
if not IsGammaAvailable then
Exit(FadeToBlack);
startTicks := TickCount;
while TickCount < startTicks + ticks do
begin
i := 100 * (startTicks + ticks - TickCount) div ticks;
oe := DoGammaFade(i);
if Button then
begin
oe := DoGammaFade(0);
Exit(FadeToBlack);
end;
end;
oe := DoGammaFade(0);
end; {FadeToBlack}
procedure FadeFromBlack (ticks: Longint);
var
i: integer;
oe: OSErr;
startTicks: Longint;
begin
if not IsGammaAvailable then
Exit(FadeFromBlack);
startTicks := TickCount;
while TickCount < startTicks + ticks do
begin
i := 100 - 100 * (startTicks + ticks - TickCount) div ticks;
oe := DoGammaFade(i);
if Button then
begin
oe := DoGammaFade(100);
Exit(FadeFromBlack);
end;
end;
oe := DoGammaFade(100);
end; {FadeFromBlack}
function IsGammaAvailable: Boolean;
var
theGDevice: GDHandle;
begin
IsGammaAvailable := false;
if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
exit(IsGammaAvailable);
theGDevice := GetDeviceList;
while (theGDevice <> nil) do
begin
if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
exit(IsGammaAvailable);
if (theGDevice^^.gdType = fixedType) then
exit(IsGammaAvailable);
theGDevice := GetNextDevice(theGDevice);
end;
IsGammaAvailable := true; {If we made it this far then its true}
end;
function IsOneGammaAvailable (theGDevice: GDHandle): Boolean;
begin
IsOneGammaAvailable := false;
if (NGetTrapAddress(kGetDeviceListTrapNum, ToolTrap) = NGetTrapAddress(_Unimplemented, ToolTrap)) then
exit(IsOneGammaAvailable);
if (TestDeviceAttribute(theGDevice, screenDevice) and TestDeviceAttribute(theGDevice, noDriver)) then
exit(IsOneGammaAvailable);
if (theGDevice^^.gdType = fixedType) then
exit(IsOneGammaAvailable);
IsOneGammaAvailable := true;
end;
function SetupGammaTools: OSErr;
var
errorCold: OSErr;
tempHdl: GlobalGammasHdl;
masterGTable: GammaTblPtr;
theGDevice: GDHandle;
begin
if (gammaUtilsInstalled = kGammaUtilsSig) then
begin
SetupGammaTools := -1;
exit(SetupGammaTools);
end;
gammaTables := nil;
gammaUtilsInstalled := kGammaUtilsSig;
theGDevice := GetDeviceList;
while (theGDevice <> nil) do
begin
errorCold := GetDevGammaTable(theGDevice, masterGTable);
if (errorCold <> 0) then
begin
SetupGammaTools := errorCold;
exit(SetupGammaTools);
end;
tempHdl := globalGammasHdl(NewHandle(sizeof(globalGammas)));
if (tempHdl = nil) then
begin
SetupGammaTools := MemError;
exit(SetupGammaTools);
end;
with masterGTable^ do
begin
tempHdl^^.size := sizeof(GammaTbl) + gFormulaSize + (gChanCnt * gDataCnt * gDataWidth div 8);
tempHdl^^.dataOffset := gFormulaSize;
tempHdl^^.theGDevice := theGDevice;
end;
tempHdl^^.saved := GammaTblHandle(NewHandle(tempHdl^^.size));
if (tempHdl^^.saved = nil) then
begin
SetupGammaTools := MemError;
exit(SetupGammaTools);
end;
tempHdl^^.hacked := GammaTblHandle(NewHandle(tempHdl^^.size));
if (tempHdl^^.hacked = nil) then
begin
SetupGammaTools := MemError;
exit(SetupGammaTools);
end;
BlockMove(Ptr(masterGTable), Ptr(tempHdl^^.saved^), tempHdl^^.size);
tempHdl^^.next := gammaTables;
gammaTables := tempHdl;
theGDevice := GetNextDevice(theGDevice)
end;
SetupGammaTools := 0;
end;
function DoGammaFade (percent: Integer): OSErr;
var
errorCold: OSErr;
thesize, i, theNum: LongInt;
tempHdl: GlobalGammasHdl;
dataPtr: Ptr;
tempGammaTbl: GammaTblPtr;
gdp: GammaDataPtr;
tempLong: Longint;
begin
if gammaUtilsInstalled <> kGammaUtilsSig then
errorCold := SetupGammaTools;
if gammaUtilsInstalled <> kGammaUtilsSig then
begin
DoGammaFade := -1;
exit(DoGammaFade);
end;
tempHdl := gammaTables;
while (tempHdl <> nil) do
begin
with tempHdl^^ do
begin
BlockMove(Ptr(saved^), Ptr(hacked^), size);
tempLong := ord(@hacked^^.gFormulaData) + dataOffset;
gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
end;
for i := 0 to thesize - 1 do
begin
theNum := gdp^[i];
theNum := (theNum * percent) div 100;
gdp^[i] := theNum;
end;
errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
if (errorCold <> 0) then
begin
DoGammaFade := errorCold;
exit(DoGammaFade);
end;
tempHdl := tempHdl^^.next;
end;
DoGammaFade := 0;
end;
function DoOneGammaFade (theGDevice: GDHandle; percent: Integer): OSErr;
var
errorCold: OSErr;
thesize, i, theNum: LongInt;
tempHdl: GlobalGammasHdl;
gdp: GammaDataPtr;
begin
if gammaUtilsInstalled <> kGammaUtilsSig then
errorCold := SetupGammaTools;
if gammaUtilsInstalled <> kGammaUtilsSig then
begin
DoOneGammaFade := -1;
Exit(DoOneGammaFade);
end;
tempHdl := gammaTables;
while ((tempHdl <> nil) and (theGDevice <> tempHdl^^.theGDevice)) do
tempHdl := tempHdl^^.next;
with tempHdl^^ do
begin
BlockMove(Ptr(saved^), Ptr(hacked^), size);
gdp := gammaDataPtr(ord(@hacked^^.gFormulaData) + dataOffset);
thesize := hacked^^.gChanCnt * hacked^^.gDataCnt;
end;
for i := 0 to thesize - 1 do
begin
theNum := gdp^[i];
theNum := (theNum * percent) div 100;
gdp^[i] := theNum;
end;
errorCold := SetDevGammaTable(tempHdl^^.theGDevice, tempHdl^^.hacked^);
DoOneGammaFade := errorCold;
end;
function DisposeGammaTools: OSErr;
var
tempHdl, nextHdl: GlobalGammasHdl;
begin
if gammaUtilsInstalled <> kGammaUtilsSig then
begin
DisposeGammaTools := -1;
Exit(DisposeGammaTools);
end;
tempHdl := gammaTables;
while (tempHdl <> nil) do
begin
HLock(Handle(tempHdl));
with tempHdl^^ do
begin
nextHdl := next;
DisposeHandle(Handle(saved));
DisposeHandle(Handle(hacked));
HUnLock(Handle(tempHdl));
DisposeHandle(Handle(tempHdl));
tempHdl := nextHdl;
end;
end;
gammaUtilsInstalled := ' ';
DisposeGammaTools := 0;
end;
function GetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
var
errorCold: OSErr;
myCPB: ParmBlkPtr;
begin
theTable := nil;
if not IsOneGammaAvailable(theGDevice) then
begin
GetDevGammaTable := -1;
exit(GetDevGammaTable);
end;
myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
if (myCPB = nil) then
begin
GetDevGammaTable := MemError;
exit(GetDevGammaTable);
end;
myCPB^.csCode := cscGetGamma;
myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
myCPB^.csParam[0] := HiWord(longint(@theTable));
myCPB^.csParam[1] := LoWord(longint(@theTable));
{$IFC UNDEFINED THINK_PASCAL}
errorCold := PBStatusSync(myCPB);
{$ELSEC}
errorCold := PBStatus(myCPB, false);
{$ENDC}
DisposePtr(Ptr(myCPB));
GetDevGammaTable := errorCold;
end;
function SetDevGammaTable (theGDevice: GDHandle; var theTable: GammaTblPtr): OSErr;
var
myCPB: ParmBlkPtr;
errorCold: OSErr;
cTab: CTabHandle;
saveGDevice: GDHandle;
begin
if not IsOneGammaAvailable(theGDevice) then
begin
SetDevGammaTable := -1;
exit(SetDevGammaTable);
end;
myCPB := ParmBlkPtr(NewPtrClear(sizeof(ParamBlockRec)));
if (myCPB = nil) then
begin
SetDevGammaTable := MemError;
exit(SetDevGammaTable);
end;
myCPB^.csCode := cscSetGamma;
myCPB^.ioCRefNum := theGDevice^^.gdRefNum;
myCPB^.csParam[0] := HiWord(longint(@theTable));
myCPB^.csParam[1] := LoWord(longint(@theTable));
{$IFC UNDEFINED THINK_PASCAL}
errorCold := PBControlSync(myCPB);
{$ELSEC}
errorCold := PBControl(myCPB, false);
{$ENDC}
if (errorCold = 0) then
begin
saveGDevice := GetGDevice;
SetGDevice(theGDevice);
cTab := theGDevice^^.gdPMap^^.pmTable;
SetEntries(0, cTab^^.ctSize, cTab^^.ctTable);
SetGDevice(saveGDevice);
end;
DisposePtr(Ptr(myCPB));
SetDevGammaTable := errorCold;
end;
end.